home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Zoom 2
/
Zoom - Release 2 (1996)(Active Software)[!].iso
/
misc
/
scion409
/
scionarexx.lha
/
Soundex.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1995-09-21
|
11KB
|
333 lines
/****************************************************************************
* *
* $VER: Soundex 1.02 (24 Aug 1995)
* *
* Written by Freddy Ariës *
* *
* Program for Scion Genealogist 4.0 and above (no guarantees are given *
* for lower versions). This program should ask the user for a (last)name, *
* and output the list of names in the current Scion database that match *
* the entered name, using the SOUNDEX method of name comparison. *
* Scion Genealogist must be running for this script to work. *
* *
* For those who don't know what SOUNDEX is, here is a short intro: *
* *
* The Soundex system is the means established by the National Archives *
* to index the U.S. censuses (beginning with 1880). It codes together *
* surnames of the same and similar sounds but of variant spellings. *
* Soundexes are arranged by state, Soundex code of the surname, and *
* given name. *
* *
* Soundex codes begin with the first letter of the surname followed by a *
* three-digit code that represents the (first three) remaining consonants. *
* This Soundex converter will do the tricky work for you and capture the *
* nuances of the coding scheme (such as coding adjacent like letters as *
* one). Just enter the surname that you want coded. *
* *
* Soundex Coding Guide *
* 1 = B,P,F,V *
* 2 = C,S,G,J,K,Q,X,Z *
* 3 = D,T *
* 4 = L *
* 5 = M,N *
* 6 = R *
* *
* The letters A,E,I,O,U,Y,H and W are not coded. *
* *
* Note that surname prefixes such as Van, Von, Di, De, Le, D', dela, or *
* du are sometimes disregarded in alphabetizing and in coding. *
* Therefor it is wise to code it with and without the prefix because it *
* may be listed under either code. Eg. Van Hoesen could be coded as *
* VanHoesen or as Hoesen. *
* *
* TO DO: *
* - Automatically do the above coding (2 alternatives) for prefixes. *
* - Suggestions, comments, bugreports, donations, etc. are appreciated. *
* *
* FIXED (v1.02): *
* - 2 consecutive letters with the same code are now treated as one *
* eg. LLOYD=LOYD -> [LD=L300], and JACKSON (CKS are all 2) -> [JCN=J250] *
* *
****************************************************************************/
options failat 20; options results
arg srchstr outname outval
versionstr = "1.02"
usereq = 1; /* change this to 0 if you don't want to use reqtools */
outp = 1; output = stdout
NL = '0A'x
plwidth = 78; /* linewidth of the printer */
sxlen = 3; /* the length of the soundex-code is usually 3,
* but if you insist, you can use a longer code
*/
signal on IOERR
/* parse command line options, to enable calling the script automatically,
* eg. from a function key
*/
do while srchstr = '?'
writeln(stdout, "SEARCHNAME/A,OUTFILE/A,QUIET/S,NOREQ/S ")
pull srchstr outname outval
end
if srchstr ~= "" then do
if srchstr = "QUIET" | srchstr = "NOREQ" then do
outval = srchstr; srchstr = ""
end
end
if outval = "QUIET" then do
outp = 0; usereq = 0
end
else if outval = "NOREQ" then usereq = 0
if usereq & ~show('l','rexxreqtools.library') then do
if exists('libs:rexxreqtools.library') then
call addlib('rexxreqtools.library',0,-30,0)
else do
usereq = 0; outp = 1
Tell("Unable to open rexxreqtools.library - using text output")
end
end
/* These first few lines are stolen from Peter Billings - thanks Peter ;-) */
if ~show('P','SCIONGEN') then do
TermError('I am sorry to say that the SCION Genealogist' || NL ||,
'database is not available. Please start the' || NL ||,
'SCION program BEFORE using this script!')
end
/* Printer Codes (some of which are currently unused): */
ESC = '1B'x
prtinit = ESC||"#1"; /* ESC#1 initialize */
prtundon = ESC||"[4m"; /* ESC[4m underline on */
prtundoff = ESC||"[24m"; /* ESC[24m underline off */
prtdson = ESC||"[1m"; /* ESC[1m boldface on */
prtdsoff = ESC||"[22m"; /* ESC[22m boldface off */
prtnlqon = ESC||"[2"||'22'x||"z"; /* ESC[2"z NLQ on */
prtnlqoff = ESC||"[1"||'22'x||"z"; /* ESC[1"z NLQ off */
MyPort = "SCIONGEN"
Address value MyPort
GETDBNAME
dbname = upper(RESULT)
if outp & ~usereq then do
Tell("Scion SOUNDEX script v"||versionstr||" by Freddy Ariës")
Tell("Database: "||dbname|| NL)
end
if srchstr = '' then do
if usereq then do
srchname = rtgetstring(,'Enter the surname to search for: '||,
NL,'Input Request:','_Continue','rt_pubscrname = '||PSCR)
if srchname = '' then
EXIT
srchname = upper(srchname)
end
else do
TellNN("Enter the surname to search for: ")
pull srchname
end
end
else do
srchname = upper(srchstr)
end
if usereq then do
if outname = "" then do
odev = rtezrequest('Current Scion database: '||dbname||,
NL||'Where should the output be sent to?'||,
NL,' _File |_Printer|_Screen|_Nowhere','Scion SOUNDEX script v'||versionstr||' by Freddy Ariës','rt_pubscrname = '||PSCR)
select
when odev = 1 then do
/* We need a file requester for further data */
dblen = length(dbname)
if dblen>6 & right(dbname, 6)=".SCION" then
dbname=left(dbname, dblen - 6)
outname = rtfilerequest(,dbname||'.SDX','Output filename',,'rtfi_buffer = true rt_pubscrname = '||PSCR||' rtfi_initialpath = RAM:',)
if outname = '' then
outname = dbname||'.SDX'
end
when odev = 2 then
outname = 'PRT:'
when odev = 3 then
outname = 'STDOUT'
otherwise
EXIT
/* You selected 'Nowhere' */
end
end
useirn = rtezrequest('Do you want to output the IRNs'||,
NL||'(the record numbers) as well?'||,
'',' _Yes| _No ','Input Request:','rt_pubscrname = '||PSCR)
end
else do
if outname = "" then do
Tell("Enter output file (filename with complete path, or PRT: for printer,")
TellNN("or STDOUT for screen): ")
pull outname
if outname = "" then
outname = "STDOUT"
end
TellNN("Do you want to output the IRNs (numbers) as well (y/n)? ")
pull instr
Tell("")
if left(instr, 1) = "Y" then useirn = 1
else useirn = 0
end
/* convert the entered string to a SOUNDEX search pattern */
spat = GetSoundex(srchname)
if spat = 'A' then do
TermError("Unable to create soundex code for name string!")
end
/* Make a list of all the people in the database whose surname matches
* the given lastname (ie. matching soundex codes)
*/
OpenPrinter()
GETTOTALIRN
TotalIRN = RESULT
do i = 1 to TotalIRN
EXISTPERSON i
if RESULT = 'YES' then
do
GETLASTNAME i
lname = upper(RESULT)
ccode = GetSoundex(lname)
if ccode = spat then do
/* Found a match - output the name */
GETFIRSTNAME i
fnames = RESULT
if useirn then
oline = left(i||". ",6)
else
oline = ""
oline = oline||lname||", "||fnames
writeln(prtdev, oline)
end
end
end
writeln(prtdev, prtnlqoff); /* ESC[1"z NLQ off */
close(prtdev)
EXIT
/* Some special purpose routines for Soundex */
GetSoundex: PROCEDURE EXPOSE sxlen
parse arg nstr
found = 0
wstr = upper(nstr)
ix = 1; wix = 0; wval = 0
wlen = length(wstr)
code = 'A';
/* Find first letter from the string */
do while ~found & (wix < wlen)
wix = wix + 1
c = substr(wstr,wix,1)
if c >= 'A' & c <= 'Z' then do
found = 1
code = c
end
else if c = ',' then wix = wlen
/* Everything after a comma is skipped - for now.
* The assumption is made that everything after a comma is prefixes.
* eg. Von Hoesen can be stored as "Von Hoesen", or as "Hoesen, Von"
* In the first case, it will become "V525", in the 2nd "H250"
*/
end
if ~found then return code
pv = GetValue(code)
/* Append a 3-digit (sxlen-size) code to the letter */
do while ix <= sxlen & wix < wlen
wix = wix + 1
wval = GetValue(substr(wstr,wix,1))
if wval > 0 & wval ~= pv then do
code = code||wval
say "adding "substr(wstr,wix,1)
pv = wval
ix = ix + 1
end
else if wval ~= pv then pv = ''
end
do while ix <= sxlen
code = code||"0"
ix = ix + 1
end
return code
GetValue: PROCEDURE
parse arg c
if c = 'B' | c = 'F' | c = 'P' | c = 'V' then return 1
if c = 'C' | c = 'G' | c = 'J' | c = 'K' | c = 'Q' | c = 'S' | c = 'X' | c = 'Z' then return 2
if c = 'D' | c = 'T' then return 3
if c = 'L' then return 4
if c = 'M' | c = 'N' then return 5
if c = 'R' then return 6
return 0
/* General purpose requesters */
OpenPrinter:
/* Open the printer device and print out a nice header */
if outname = "STDOUT" then
prtdev = stdout
else do
prtdev = 'PRINTER'
if ~open(prtdev, outname, 'w') then
TermError("ERROR: Failed to open output file!")
end
writeln(prtdev, prtinit||prtnlqon)
prtstr = prtundon||prtdson||"SOUNDEX listing for "||srchname||" (Soundex code: "||spat||")"||prtdsoff||prtundoff
writeln(prtdev, prtstr)
prtstr = prtdson||"Report printed on: "||date()||" "||"database: "||dbname||prtdsoff
writeln(prtdev, prtstr)
prtstr = copies('=', plwidth)
writeln(prtdev, prtstr)
return 0
Tell: PROCEDURE EXPOSE outp
parse arg str
if outp then
writeln(stdout, str)
return 0
TellNN: PROCEDURE EXPOSE outp
parse arg str
if outp then
writech(stdout, str)
return 0
TermError: PROCEDURE EXPOSE outp prtdev usereq PSCR
parse arg str
/* If you turned off stdout, no error messages will be shown! */
if usereq then
rtezrequest(str,'E_xit','Soundex Message:','rt_pubscrname = '||PSCR)
else do
Tell(str || '0A'x)
end
close(prtdev)
EXIT
/* Let's make sure you get a nice message when you turn off the printer :-) */
IOERR:
bline = SIGL
say "I/O error #"||RC||" detected in line "||bline||":"
say sourceline(bline)
EXIT